From: Kenichi Handa Date: Fri, 26 Nov 2010 04:06:59 +0000 (+0900) Subject: Improve rmail's MIME handling. X-Git-Tag: archive/raspbian/1%29.2+1-2+rpi1~1^2~421^2~18^2~16^2~27 X-Git-Url: https://dgit.raspbian.org/%22http:/www.example.com/cgi/%22https:/www.github.com/%22bookmarks:///%22http:/www.example.com/cgi/%22https:/www.github.com/%22bookmarks:/?a=commitdiff_plain;h=7a317f9554dffa6815df0bde873bf6aeffd45338;p=emacs.git Improve rmail's MIME handling. --- 7a317f9554dffa6815df0bde873bf6aeffd45338 diff --cc lisp/ChangeLog index 5dddb55789e,5dddb55789e..6902db6310f --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@@ -1,3 -1,3 +1,46 @@@ ++2010-11-26 Kenichi Handa ++ ++ * mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type) ++ (rmail-mime-entity-disposition) ++ (rmail-mime-entity-transfer-encoding, rmail-mime-entity-header) ++ (rmail-mime-entity-body, rmail-mime-entity-children): New functions. ++ (rmail-mime-save): Handle the case that the button's `data' is a ++ MIME entity. ++ (rmail-mime-insert-text): New function. ++ (rmail-mime-insert-image): Handle the case that DATA is a MIME ++ entity. ++ (rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk. ++ (rmail-mime-insert-bulk): New function mostly copied from the old ++ rmail-mime-bulk-handler. ++ (rmail-mime-multipart-handler): Just call ++ rmail-mime-process-multipart. ++ (rmail-mime-process-multipart): New funciton mostly copied from ++ the old rmail-mime-multipart-handler. ++ (rmail-mime-show): Just call rmail-mime-process. ++ (rmail-mime-process): New funciton mostly copied from the old ++ rmail-mime-show. ++ (rmail-mime-insert-multipart, rmail-mime-parse) ++ (rmail-mime-insert, rmail-show-mime) ++ (rmail-insert-mime-forwarded-message) ++ (rmail-insert-mime-resent-message): New functions. ++ (rmail-insert-mime-forwarded-message-function): Set to ++ rmail-insert-mime-forwarded-message. ++ (rmail-insert-mime-resent-message-function): Set to ++ rmail-insert-mime-resent-message. ++ ++ * mail/rmailsum.el: Require rfc2047. ++ (rmail-header-summary): Handle multiline Subject: field. ++ (rmail-summary-line-decoder): Change the default to ++ rfc2047-decode-string. ++ ++ * mail/rmail.el (rmail-enable-mime): Change the default to t. ++ (rmail-mime-feature): Change the default to `rmailmm'. ++ (rmail-quit): Delete the specifal code for rmail-enable-mime. ++ (rmail-display-labels): Likewise. ++ (rmail-show-message-1): Check rmail-enable-mime, and use ++ rmail-show-mime-function for a MIME message. Decode the headers ++ according to RFC2047. ++ 2010-11-24 Stefan Monnier * progmodes/which-func.el (which-func-imenu-joiner-function): diff --cc lisp/mail/rmail.el index 3ab87fa21f7,3ab87fa21f7..70c84a242f5 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@@ -638,7 -638,7 +638,7 @@@ Element N specifies the summary line fo This is set to nil by default.") --(defcustom rmail-enable-mime nil ++(defcustom rmail-enable-mime t "If non-nil, RMAIL uses MIME features. If the value is t, RMAIL automatically shows MIME decoded message. If the value is neither t nor nil, RMAIL does not show MIME decoded message @@@ -649,6 -649,6 +649,7 @@@ unless the feature specified by `rmail- :type '(choice (const :tag "on" t) (const :tag "off" nil) (other :tag "when asked" ask)) ++ :version "23.3" :group 'rmail) (defvar rmail-enable-mime-composing nil @@@ -693,13 -693,13 +694,12 @@@ start of the header) with three argumen where MSG is the message number, REGEXP is the regular expression, LIMIT is the position specifying the end of header.") --(defvar rmail-mime-feature 'rmail-mime ++(defvar rmail-mime-feature 'rmailmm "Feature to require to load MIME support in Rmail. When starting Rmail, if `rmail-enable-mime' is non-nil, this feature is required with `require'. --The default value is `rmail-mime'. This feature is provided by --the rmail-mime package available at .") ++The default value is `rmailmm'") ;; FIXME this is unused. (defvar rmail-decode-mime-charset t @@@ -1509,17 -1509,17 +1509,9 @@@ Hook `rmail-quit-hook' is run after exp (set-buffer-modified-p nil)) (replace-buffer-in-windows rmail-summary-buffer) (bury-buffer rmail-summary-buffer)) -- (if rmail-enable-mime -- (let ((obuf rmail-buffer) -- (ovbuf rmail-view-buffer)) -- (set-buffer rmail-view-buffer) -- (quit-window) -- (replace-buffer-in-windows ovbuf) -- (replace-buffer-in-windows obuf) -- (bury-buffer obuf)) -- (let ((obuf (current-buffer))) -- (quit-window) -- (replace-buffer-in-windows obuf)))) ++ (let ((obuf (current-buffer))) ++ (quit-window) ++ (replace-buffer-in-windows obuf))) (defun rmail-bury () "Bury current Rmail buffer and its summary buffer." @@@ -2219,15 -2219,15 +2211,7 @@@ If nil, that means the current message. (let ((blurb (rmail-get-labels))) (setq mode-line-process (format " %d/%d%s" -- rmail-current-message rmail-total-messages blurb)) -- ;; If rmail-enable-mime is non-nil, we may have to update -- ;; `mode-line-process' of rmail-view-buffer too. -- (if (and rmail-enable-mime -- (not (eq (current-buffer) rmail-view-buffer)) -- (buffer-live-p rmail-view-buffer)) -- (let ((mlp mode-line-process)) -- (with-current-buffer rmail-view-buffer -- (setq mode-line-process mlp)))))) ++ rmail-current-message rmail-total-messages blurb)))) (defun rmail-get-attr-value (attr state) "Return the character value for ATTR. @@@ -2706,6 -2706,6 +2690,11 @@@ The current mail message becomes the me (message "Showing message %d" msg)) (narrow-to-region beg end) (goto-char beg) ++ (if (and rmail-enable-mime ++ (re-search-forward "mime-version: 1.0" nil t)) ++ (let ((rmail-buffer mbox-buf) ++ (rmail-view-buffer view-buf)) ++ (funcall rmail-show-mime-function)) (setq body-start (search-forward "\n\n" nil t)) (narrow-to-region beg (point)) (goto-char beg) @@@ -2722,11 -2722,11 +2711,6 @@@ ;; unibyte temporary buffer where the character decoding takes ;; place. (with-current-buffer rmail-view-buffer -- ;; We give the view buffer a buffer-local value of -- ;; rmail-header-style based on the binding in effect when -- ;; this function is called; `rmail-toggle-headers' can -- ;; inspect this value to determine how to toggle. -- (set (make-local-variable 'rmail-header-style) header-style) (erase-buffer)) (if (null character-coding) ;; Do it directly since that is fast. @@@ -2749,8 -2749,8 +2733,13 @@@ (error "uuencoded messages are not supported yet")) (t)) (rmail-decode-region (point-min) (point-max) -- coding-system view-buf))) ++ coding-system view-buf)))) (with-current-buffer rmail-view-buffer ++ ;; We give the view buffer a buffer-local value of ++ ;; rmail-header-style based on the binding in effect when ++ ;; this function is called; `rmail-toggle-headers' can ++ ;; inspect this value to determine how to toggle. ++ (set (make-local-variable 'rmail-header-style) header-style) ;; Unquote quoted From lines (goto-char (point-min)) (while (re-search-forward "^>+From " nil t) @@@ -2766,6 -2766,6 +2755,10 @@@ (with-current-buffer rmail-view-buffer (insert "\n") (goto-char (point-min)) ++ ;; Decode the headers according to RFC2047. ++ (save-excursion ++ (search-forward "\n\n" nil 'move) ++ (rfc2047-decode-region (point-min) (point))) (rmail-highlight-headers) ;(rmail-activate-urls) ;(rmail-process-quoted-material) diff --cc lisp/mail/rmailmm.el index e8ca11ee349,e8ca11ee349..6dfa92aa93a --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@@ -26,17 -26,17 +26,57 @@@ ;; Essentially based on the design of Alexander Pohoyda's MIME ;; extensions (mime-display.el and mime.el). --;; Call `M-x rmail-mime' when viewing an Rmail message. ++ ++;; This file provides two operation modes for viewing a MIME message. ++ ++;; (1) When rmail-enable-mime is non-nil (now it is the default), the ++;; function `rmail-show-mime' is automatically called. That function ++;; shows a MIME message directly in RMAIL's view buffer. ++ ++;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x ++;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*". ++ ++;; Both operations share the intermediate functions rmail-mime-process ++;; and rmail-mime-process-multipart as below. ++ ++;; rmail-show-mime ++;; +- rmail-mime-parse ++;; | +- rmail-mime-process <--+------------+ ++;; | | +---------+ | ++;; | + rmail-mime-process-multipart --+ ++;; | ++;; + rmail-mime-insert <----------------+ ++;; +- rmail-mime-insert-text | ++;; +- rmail-mime-insert-bulk | ++;; +- rmail-mime-insert-multipart --+ ++;; ++;; rmail-mime ++;; +- rmail-mime-show <----------------------------------+ ++;; +- rmail-mime-process | ++;; +- rmail-mime-handle | ++;; +- rmail-mime-text-handler | ++;; +- rmail-mime-bulk-handler | ++;; | + rmail-mime-insert-bulk ++;; +- rmail-mime-multipart-handler | ++;; +- rmail-mime-process-multipart --+ ++ ++;; In addition, for the case of rmail-enable-mime being non-nil, this ++;; file provides two functions rmail-insert-mime-forwarded-message and ++;; rmail-insert-mime-resent-message for composing forwarded and resent ++;; messages respectively. ;; Todo: --;; Handle multipart/alternative. ++;; Make rmail-mime-media-type-handlers-alist usable in the first ++;; operation mode. ++;; Handle multipart/alternative in the second operation mode. ;; Offer the option to call external/internal viewers (doc-view, xpdf, etc). ;;; Code: (require 'rmail) (require 'mail-parse) ++(require 'message) ;;; User options. @@@ -90,6 -90,6 +130,52 @@@ automatically display the image in the ;;; End of user options. ++;;; MIME-entity object ++ ++(defun rmail-mime-entity (type disposition transfer-encoding ++ header body children) ++ "Retrun a newly created MIME-entity object. ++ ++A MIME-entity is a vector of 6 elements: ++ ++ [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ] ++ ++TYPE and DISPOSITION correspond to MIME headers Content-Type: and ++Cotent-Disposition: respectively, and has this format: ++ ++ \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) ++ ++VALUE is a string and ATTRIBUTE is a symbol. ++ ++Consider the following header, for example: ++ ++Content-Type: multipart/mixed; ++ boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\" ++ ++The corresponding TYPE argument must be: ++ ++\(\"multipart/mixed\" ++ \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\")) ++ ++TRANSFER-ENCODING corresponds to MIME header ++Content-Transfer-Encoding, and is a lowercased string. ++ ++HEADER and BODY are a cons (BEG . END), where BEG and END specify ++the region of the corresponding part in RMAIL's data (mbox) ++buffer. BODY may be nil. In that case, the current buffer is ++narrowed to the body part. ++ ++CHILDREN is a list of MIME-entities for a \"multipart\" entity, and ++nil for the other types." ++ (vector type disposition transfer-encoding header body children)) ++ ++;; Accessors for a MIME-entity object. ++(defsubst rmail-mime-entity-type (entity) (aref entity 0)) ++(defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) ++(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) ++(defsubst rmail-mime-entity-header (entity) (aref entity 3)) ++(defsubst rmail-mime-entity-body (entity) (aref entity 4)) ++(defsubst rmail-mime-entity-children (entity) (aref entity 5)) ;;; Buttons @@@ -98,6 -98,6 +184,7 @@@ (let* ((filename (button-get button 'filename)) (directory (button-get button 'directory)) (data (button-get button 'data)) ++ (mbox-buf rmail-view-buffer) (ofilename filename)) (setq filename (expand-file-name (read-file-name (format "Save as (default: %s): " filename) @@@ -116,7 -116,7 +203,17 @@@ ;; file, the magic signature compares equal with the unibyte ;; signature string recorded in jka-compr-compression-info-list. (set-buffer-multibyte nil) -- (insert data) ++ (setq buffer-undo-list t) ++ (if (stringp data) ++ (insert data) ++ ;; DATA is a MIME-entity object. ++ (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) ++ (body (rmail-mime-entity-body data))) ++ (insert-buffer-substring mbox-buf (car body) (cdr body)) ++ (cond ((string= transfer-encoding "base64") ++ (ignore-errors (base64-decode-region (point-min) (point-max)))) ++ ((string= transfer-encoding "quoted-printable") ++ (quoted-printable-decode-region (point-min) (point-max)))))) (write-region nil nil filename nil nil nil t)))) (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) @@@ -133,6 -133,6 +230,23 @@@ (when (coding-system-p coding-system) (decode-coding-region (point-min) (point-max) coding-system)))) ++(defun rmail-mime-insert-text (entity) ++ "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer." ++ (let* ((content-type (rmail-mime-entity-type entity)) ++ (charset (cdr (assq 'charset (cdr content-type)))) ++ (coding-system (if charset (intern (downcase charset)))) ++ (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) ++ (body (rmail-mime-entity-body entity))) ++ (save-restriction ++ (narrow-to-region (point) (point)) ++ (insert-buffer-substring rmail-buffer (car body) (cdr body)) ++ (cond ((string= transfer-encoding "base64") ++ (ignore-errors (base64-decode-region (point-min) (point-max)))) ++ ((string= transfer-encoding "quoted-printable") ++ (quoted-printable-decode-region (point-min) (point-max)))) ++ (if (coding-system-p coding-system) ++ (decode-coding-region (point-min) (point-max) coding-system))))) ++ ;; FIXME move to the test/ directory? (defun test-rmail-mime-handler () "Test of a mail using no MIME parts at all." @@@ -151,10 -151,10 +265,28 @@@ MIME-Version: 1. (defun rmail-mime-insert-image (type data) -- "Insert an image of type TYPE, where DATA is the image data." ++ "Insert an image of type TYPE, where DATA is the image data. ++If DATA is not a string, it is a MIME-entity object." (end-of-line) -- (insert ?\n) -- (insert-image (create-image data type t))) ++ (let ((modified (buffer-modified-p))) ++ (insert ?\n) ++ (unless (stringp data) ++ ;; DATA is a MIME-entity. ++ (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) ++ (body (rmail-mime-entity-body data)) ++ (mbox-buffer rmail-view-buffer)) ++ (with-temp-buffer ++ (set-buffer-multibyte nil) ++ (setq buffer-undo-list t) ++ (insert-buffer-substring mbox-buffer (car body) (cdr body)) ++ (cond ((string= transfer-encoding "base64") ++ (ignore-errors (base64-decode-region (point-min) (point-max)))) ++ ((string= transfer-encoding "quoted-printable") ++ (quoted-printable-decode-region (point-min) (point-max)))) ++ (setq data ++ (buffer-substring-no-properties (point-min) (point-max)))))) ++ (insert-image (create-image data type t)) ++ (set-buffer-modified-p modified))) (defun rmail-mime-image (button) "Display the image associated with BUTTON." @@@ -171,8 -171,8 +303,19 @@@ "Handle the current buffer as an attachment to download. For images that Emacs is capable of displaying, the behavior depends upon the value of `rmail-mime-show-images'." ++ (rmail-mime-insert-bulk ++ (rmail-mime-entity content-type content-disposition content-transfer-encoding ++ nil nil nil))) ++ ++(defun rmail-mime-insert-bulk (entity) ++ "Inesrt a MIME-entity ENTITY as an attachment. ++The optional second arg DATA, if non-nil, is a string containing ++the attachment data that is already decoded." ;; Find the default directory for this media type. -- (let* ((directory (catch 'directory ++ (let* ((content-type (rmail-mime-entity-type entity)) ++ (content-disposition (rmail-mime-entity-disposition entity)) ++ (body (rmail-mime-entity-body entity)) ++ (directory (catch 'directory (dolist (entry rmail-mime-attachment-dirs-alist) (when (string-match (car entry) (car content-type)) (dolist (dir (cdr entry)) @@@ -182,17 -182,17 +325,21 @@@ (cdr (assq 'filename (cdr content-disposition))) "noname")) (label (format "\nAttached %s file: " (car content-type))) -- (data (buffer-string)) -- (udata (string-as-unibyte data)) -- (size (length udata)) -- (osize size) (units '(B kB MB GB)) -- type) -- (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message ++ data udata size osize type) ++ (if body ++ (setq data entity ++ udata entity ++ size (- (cdr body) (car body))) ++ (setq data (buffer-string) ++ udata (string-as-unibyte data) ++ size (length udata)) ++ (delete-region (point-min) (point-max))) ++ (setq osize size) ++ (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message (cdr units)) (setq size (/ size 1024.0) units (cdr units))) -- (delete-region (point-min) (point-max)) (insert label) (insert-button filename :type 'rmail-mime-save @@@ -248,6 -248,6 +395,22 @@@ The current buffer should be narrowed t CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values of the respective parsed headers. See `rmail-mime-handle' for their format." ++ (rmail-mime-process-multipart ++ content-type content-disposition content-transfer-encoding nil)) ++ ++(defun rmail-mime-process-multipart (content-type ++ content-disposition ++ content-transfer-encoding ++ parse-only) ++ "Process the current buffer as a multipart MIME body. ++ ++If PARSE-ONLY is nil, modify the current buffer directly for showing ++the MIME body and return nil. ++ ++Otherwise, just parse the current buffer and return a list of ++MIME-entity objects. ++ ++The other arguments are the same as `rmail-mime-multipart-handler'." ;; Some MUAs start boundaries with "--", while it should start ;; with "CRLF--", as defined by RFC 2046: ;; The boundary delimiter MUST occur at the beginning of a line, @@@ -256,7 -256,7 +419,7 @@@ ;; of the preceding part. ;; We currently don't handle that. (let ((boundary (cdr (assq 'boundary content-type))) -- beg end next) ++ beg end next entities) (unless boundary (rmail-mm-get-boundary-error-message "No boundary defined" content-type content-disposition @@@ -266,7 -266,7 +429,9 @@@ (goto-char (point-min)) (when (and (search-forward boundary nil t) (looking-at "[ \t]*\n")) -- (delete-region (point-min) (match-end 0))) ++ (if parse-only ++ (narrow-to-region (match-end 0) (point-max)) ++ (delete-region (point-min) (match-end 0)))) ;; Loop over all body parts, where beg points at the beginning of ;; the part and end points at the end of the part. next points at ;; the beginning of the next part. @@@ -284,13 -284,13 +449,17 @@@ (rmail-mm-get-boundary-error-message "Malformed boundary" content-type content-disposition content-transfer-encoding))) -- (delete-region end next) ;; Handle the part. -- (save-restriction -- (narrow-to-region beg end) -- (rmail-mime-show)) -- (goto-char (setq beg next))))) -- ++ (if parse-only ++ (save-restriction ++ (narrow-to-region beg end) ++ (setq entities (cons (rmail-mime-process nil t) entities))) ++ (delete-region end next) ++ (save-restriction ++ (narrow-to-region beg end) ++ (rmail-mime-show))) ++ (goto-char (setq beg next))) ++ (nreverse entities))) (defun test-rmail-mime-multipart-handler () "Test of a mail used as an example in RFC 2046." @@@ -393,6 -393,6 +562,9 @@@ called recursively if multiple parts ar The current buffer must contain a single message. It will be modified." ++ (rmail-mime-process show-headers nil)) ++ ++(defun rmail-mime-process (show-headers parse-only) (let ((end (point-min)) content-type content-transfer-encoding @@@ -436,14 -436,14 +608,105 @@@ ;; attachment according to RFC 2183. (unless (member (car content-disposition) '("inline" "attachment")) (setq content-disposition '("attachment"))) -- ;; Hide headers and handle the part. -- (save-restriction -- (cond ((string= (car content-type) "message/rfc822") -- (narrow-to-region end (point-max))) -- ((not show-headers) -- (delete-region (point-min) end))) -- (rmail-mime-handle content-type content-disposition -- content-transfer-encoding)))) ++ ++ (if parse-only ++ (cond ((string-match "multipart/.*" (car content-type)) ++ (setq end (1- end)) ++ (save-restriction ++ (let ((header (if show-headers (cons (point-min) end)))) ++ (narrow-to-region end (point-max)) ++ (rmail-mime-entity content-type ++ content-disposition ++ content-transfer-encoding ++ header nil ++ (rmail-mime-process-multipart ++ content-type content-disposition ++ content-transfer-encoding t))))) ++ ((string-match "message/rfc822" (car content-type)) ++ (or show-headers ++ (narrow-to-region end (point-max))) ++ (rmail-mime-process t t)) ++ (t ++ (rmail-mime-entity content-type ++ content-disposition ++ content-transfer-encoding ++ nil ++ (cons end (point-max)) ++ nil))) ++ ;; Hide headers and handle the part. ++ (save-restriction ++ (cond ((string= (car content-type) "message/rfc822") ++ (narrow-to-region end (point-max))) ++ ((not show-headers) ++ (delete-region (point-min) end))) ++ (rmail-mime-handle content-type content-disposition ++ content-transfer-encoding))))) ++ ++(defun rmail-mime-insert-multipart (entity) ++ "Insert MIME-entity ENTITY of multipart type in the current buffer." ++ (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity)) ++ "/"))) ++ (disposition (rmail-mime-entity-disposition entity)) ++ (header (rmail-mime-entity-header entity)) ++ (children (rmail-mime-entity-children entity))) ++ (if header ++ (let ((pos (point))) ++ (or (bolp) ++ (insert "\n")) ++ (insert-buffer-substring rmail-buffer (car header) (cdr header)) ++ (rfc2047-decode-region pos (point)) ++ (insert "\n"))) ++ (cond ++ ((string= subtype "mixed") ++ (dolist (child children) ++ (rmail-mime-insert child '("text/plain") disposition))) ++ ((string= subtype "digest") ++ (dolist (child children) ++ (rmail-mime-insert child '("message/rfc822") disposition))) ++ ((string= subtype "alternative") ++ (let (best-plain-text best-text) ++ (dolist (child children) ++ (if (string= (or (car (rmail-mime-entity-disposition child)) ++ (car disposition)) ++ "inline") ++ (if (string-match "text/plain" ++ (car (rmail-mime-entity-type child))) ++ (setq best-plain-text child) ++ (if (string-match "text/.*" ++ (car (rmail-mime-entity-type child))) ++ (setq best-text child))))) ++ (if (or best-plain-text best-text) ++ (rmail-mime-insert (or best-plain-text best-text)) ++ ;; No child could be handled. Insert all. ++ (dolist (child children) ++ (rmail-mime-insert child nil disposition))))) ++ (t ++ ;; Unsupported subtype. Insert all as attachment. ++ (dolist (child children) ++ (rmail-mime-insert-bulk child)))))) ++ ++(defun rmail-mime-parse () ++ "Parse the current Rmail message as a MIME message. ++The value is a MIME-entiy object (see `rmail-mime-enty-new')." ++ (save-excursion ++ (goto-char (point-min)) ++ (rmail-mime-process nil t))) ++ ++(defun rmail-mime-insert (entity &optional content-type disposition) ++ "Insert a MIME-entity ENTITY in the current buffer. ++ ++This function will be called recursively if multiple parts are ++available." ++ (if (rmail-mime-entity-children entity) ++ (rmail-mime-insert-multipart entity) ++ (setq content-type ++ (or (rmail-mime-entity-type entity) content-type)) ++ (setq disposition ++ (or (rmail-mime-entity-disposition entity) disposition)) ++ (if (and (string= (car disposition) "inline") ++ (string-match "text/.*" (car content-type))) ++ (rmail-mime-insert-text entity) ++ (rmail-mime-insert-bulk entity)))) (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" "Major mode used in `rmail-mime' buffers." @@@ -479,6 -479,6 +742,50 @@@ attachments as specfied by `rmail-mime- (error "%s; type: %s; disposition: %s; encoding: %s" message type disposition encoding)) ++(defun rmail-show-mime () ++ (let ((mbox-buf rmail-buffer)) ++ (condition-case nil ++ (let ((entity (rmail-mime-parse))) ++ (with-current-buffer rmail-view-buffer ++ (let ((inhibit-read-only t) ++ (rmail-buffer mbox-buf)) ++ (erase-buffer) ++ (rmail-mime-insert entity)))) ++ (error ++ ;; Decoding failed. Insert the original message body as is. ++ (let ((region (with-current-buffer mbox-buf ++ (goto-char (point-min)) ++ (re-search-forward "^$" nil t) ++ (forward-line 1) ++ (cons (point) (point-max))))) ++ (with-current-buffer rmail-view-buffer ++ (let ((inhibit-read-only t)) ++ (erase-buffer) ++ (insert-buffer-substring mbox-buf (car region) (cdr region)))) ++ (message "MIME decoding failed")))))) ++ ++(setq rmail-show-mime-function 'rmail-show-mime) ++ ++(defun rmail-insert-mime-forwarded-message (forward-buffer) ++ (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer))) ++ (save-restriction ++ (narrow-to-region (point) (point)) ++ (message-forward-make-body-mime mbox-buf)))) ++ ++(setq rmail-insert-mime-forwarded-message-function ++ 'rmail-insert-mime-forwarded-message) ++ ++(defun rmail-insert-mime-resent-message (forward-buffer) ++ (insert-buffer-substring ++ (with-current-buffer forward-buffer rmail-view-buffer)) ++ (goto-char (point-min)) ++ (when (looking-at "From ") ++ (forward-line 1) ++ (delete-region (point-min) (point)))) ++ ++(setq rmail-insert-mime-resent-message-function ++ 'rmail-insert-mime-resent-message) ++ (provide 'rmailmm) ;; Local Variables: diff --cc lisp/mail/rmailsum.el index 80c65cdfb57,80c65cdfb57..2d8019b6834 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@@ -31,6 -31,6 +31,7 @@@ ;; For rmail-select-summary. (require 'rmail) ++(require 'rfc2047) (defcustom rmail-summary-scroll-between-messages t "Non-nil means Rmail summary scroll commands move between messages. @@@ -363,13 -363,13 +364,15 @@@ The current buffer contains the unrestr (aset rmail-summary-vector (1- msgnum) line)) line)) --(defcustom rmail-summary-line-decoder (function identity) ++(defcustom rmail-summary-line-decoder (function rfc2047-decode-string) "Function to decode a Rmail summary line. It receives the summary line for one message as a string and should return the decoded string. --By default, it is `identity', which returns the string unaltered." ++By default, it is `rfc2047-decode-string', which decodes MIME-encoded ++subject." :type 'function ++ :version "23.3" :group 'rmail-summary) (defun rmail-create-summary-line (msgnum) @@@ -588,10 -588,10 +591,17 @@@ the message being processed. (t (- mch 14)))) (min len (+ lo 25))))))))) (concat (if (re-search-forward "^Subject:" nil t) -- (progn (skip-chars-forward " \t") -- (buffer-substring (point) -- (progn (end-of-line) -- (point)))) ++ (let (pos str) ++ (skip-chars-forward " \t") ++ (setq pos (point)) ++ (forward-line 1) ++ (setq str (buffer-substring pos (1- (point)))) ++ (while (looking-at "\\s ") ++ (setq str (concat str " " ++ (buffer-substring (match-end 0) ++ (line-end-position)))) ++ (forward-line 1)) ++ str) (re-search-forward "[\n][\n]+" nil t) (buffer-substring (point) (progn (end-of-line) (point)))) "\n")))